Cream of the Crop 20/Cream of the Crop 20 (Terry Blount) (1996).iso/program/vol15n11.zip/TBWIZ.ZIP/TBSAVEFO.FRM

Text File | 1996-02-21 | 7KB | 243 lines

VERSION 4.00
Begin VB.Form tbSaveForm
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Save Toolbar"
   ClientHeight    =   1590
   ClientLeft      =   2850
   ClientTop       =   3315
   ClientWidth     =   4515
   ControlBox      =   0   'False
   Height          =   1995
   Left            =   2790
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1590
   ScaleWidth      =   4515
   ShowInTaskbar   =   0   'False
   Top             =   2970
   Width           =   4635
   Begin VB.CommandButton Command2
      Caption         =   "Cancel"
      Height          =   270
      Left            =   3480
      TabIndex        =   6
      Top             =   720
      Width           =   975
   End
   Begin VB.CommandButton Command1
      Caption         =   "&Save"
      Height          =   270
      Left            =   3480
      TabIndex        =   5
      Top             =   240
      Width           =   975
   End
   Begin VB.Frame Frame1
      Caption         =   "Select controls:"
      Height          =   1335
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3135
      Begin VB.ComboBox Combo1
         Height          =   315
         Index           =   1
         Left            =   1065
         TabIndex        =   4
         Text            =   "Combo1"
         Top             =   840
         Width           =   1815
      End
      Begin VB.ComboBox Combo1
         Height          =   315
         Index           =   0
         Left            =   1065
         TabIndex        =   2
         Text            =   "Combo1"
         Top             =   360
         Width           =   1815
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "ImageList:"
         Height          =   195
         Index           =   1
         Left            =   240
         TabIndex        =   3
         Top             =   860
         Width           =   720
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "Toolbar:"
         Height          =   195
         Index           =   0
         Left            =   360
         TabIndex        =   1
         Top             =   390
         Width           =   585
      End
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   3720
      Top             =   1080
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      CancelError     =   -1  'True
      DefaultExt      =   "*.tbr"
      DialogTitle     =   "Save Toolbar"
      Filter          =   "*.tbr | Toolbars"
   End
End
Attribute VB_Name = "tbSaveForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
DefInt A-Z

Function SaveTB() As Integer
'___setup vars
Dim ProjectFilename$, ProjectDirty As Boolean
Dim CurrFormName$, CurrFormFiles$(1)
Dim i%, ii%
Dim success As Boolean
'___get form file names
With gobjIDEAppInst.ActiveProject
    CurrFormName$ = .ActiveForm.Properties.Item("Name")
    With .Components
        For i% = 0 To .Count - 1
            If .Item(i%).Name = CurrFormName$ Then
                CurrFormFiles$(0) = .Item(i%).FileNames(0)
                CurrFormFiles$(1) = .Item(i%).FileNames(1)
            End If
        Next
    End With
End With
If CurrFormFiles$(0) = "" Or (Len(CurrFormFiles$(0)) = 0) Then
    Alert "Save form file first!"
    SaveTB = -1
    Exit Function
End If

'___get name of target TBR file from user
On Error Resume Next
CommonDialog1.ShowSave
If Err = cdlCancel Then SaveTB = 0: Exit Function
On Error GoTo 0
gfnameTBFile = CommonDialog1.FileName
Screen.MousePointer = HOURGLASS

'___more vars...
Dim Source$
Source$ = CurrFormFiles$(0)
Dim linetest$
Dim Targ$
Dim tbEvent$
Dim icTest$, tbTest$
Dim Terminator$
icTest$ = "ImageList " & Combo1(1)
tbTest$ = "Toolbar " & Combo1(0)
tbEvent$ = Combo1(0) & "_"
Targ$ = ExtractFilePath$(gfnameTBFile) + ExtractFileRoot(gfnameTBFile) + ".tbr"
Terminator$ = "End"
'___copy code from frm to tbr file
Open Targ$ For Output As #1
Open Source$ For Input As #2
    Do While Not EOF(2)
        Line Input #2, linetest$
        If (InStr(linetest$, icTest$) > 0) Or (InStr(linetest$, tbTest$) > 0) Then
           '___we found the toolbar or imagelist
            Print #1, linetest$
            Do
              Line Input #2, linetest$
              Print #1, linetest$
            Loop Until Trim$(linetest$) = Terminator$
         End If
     Loop
Close #2
'___now copy the toolbar's event handlers
Terminator$ = "End Sub"
Print #1, "TB_EVENTS"
Open Source$ For Input As #2
    Do While Not EOF(2)
        Line Input #2, linetest$
        If InStr(linetest$, tbEvent$) > 0 Then
            '___we found a toolbar event handler
            Print #1, linetest$
            Do
              Line Input #2, linetest$
              Print #1, linetest$
            Loop Until Trim$(linetest$) = Terminator$
        End If
    Loop
Close #2
Close #1

'___copy frx file
Targ$ = ExtractFilePath$(gfnameTBFile) + ExtractFileRoot(gfnameTBFile) + ".frx"
FileCopy ExtractFilePath$(Source$) + ExtractFileRoot(Source$) + ".frx", Targ$
SaveTB = 1
End Function

Private Sub Command1_Click()
Select Case SaveTB()
Case -1 'form hasn't been saved
Case 0  'canceled
Case 1  'success
End Select
Screen.MousePointer = DEFAULT
Unload Me

End Sub


Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Initialize()

End Sub

Private Sub Form_Load()
WinCenter Me
Dim i%, testControl As Object
'___add names of toolbars and imagelists to dialog's combo boxes
With gobjIDEAppInst.ActiveProject.ActiveForm
 For i% = 0 To .ControlTemplates.Count - 1
  Set testControl = .ControlTemplates(i)
  Select Case testControl
    Case Is = "ComctlLib.ImageList"
        Combo1(1).AddItem testControl.Properties.Item("Name")
    Case Is = "ComctlLib.Toolbar"
        Combo1(0).AddItem testControl.Properties.Item("Name")
    Case Else
  End Select
 Next i%
End With
'___can't save a toolbar if you don't have one
If (Combo1(0).ListCount * Combo1(1).ListCount) = 0 Then
        Alert "You need to add a toolbar and/or Imagelist control to this form."
        Exit Sub
End If
Combo1(0).ListIndex = 0
Combo1(1).ListIndex = 0
'___bring nonmodal dialog to top
Show
Me.SetFocus

Dim VBCap$
VBCap$ = ExtractFileRoot$(gobjIDEAppInst.ActiveProject.FileName)
SetParentByCaption VBCap$, hwnd
End Sub


Private Sub Form_Paint()

End Sub